home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Language/OS - Multiplatform Resource Library
/
LANGUAGE OS.iso
/
lisp
/
kcl
/
akcl
/
kcl.lha
/
lsp
/
iolib.c
< prev
next >
Wrap
C/C++ Source or Header
|
1987-06-04
|
16KB
|
698 lines
/* (C) Copyright Taiichi Yuasa and Masami Hagiya, 1984. All rights reserved. */
#include <cmpinclude.h>
#include "iolib.h"
init_iolib(start,size,data)char *start;int size;object data;
{ register object *base=vs_top;register object *sup=base+VM2;vs_top=sup;vs_check;
Cstart=start;Csize=size;Cdata=data;set_VV(VV,VM1,data);
base[0]= VV[0];
(void)simple_symlispcall_no_event(VV[53],base+0,1);
MM(VV[54],L2,start,size,data);
MM(VV[55],L3,start,size,data);
MM(VV[56],L4,start,size,data);
MF(VV[57],L5,start,size,data);
MF(VV[58],L6,start,size,data);
MF(VV[59],L7,start,size,data);
MF(VV[60],L8,start,size,data);
MM(VV[61],L9,start,size,data);
MF(VV[62],L10,start,size,data);
MF(VV[63],L11,start,size,data);
MF(VV[25],L12,start,size,data);
base[0]= VV[23];
base[1]= VV[24];
base[2]= VV[25];
(void)simple_symlispcall_no_event(VV[64],base+0,3);
base[0]= VV[23];
base[1]= VV[26];
base[2]= VV[25];
(void)simple_symlispcall_no_event(VV[64],base+0,3);
MF(VV[34],L15,start,size,data);
base[0]= VV[23];
base[1]= VV[33];
base[2]= VV[34];
(void)simple_symlispcall_no_event(VV[64],base+0,3);
base[0]= VV[23];
base[1]= VV[35];
base[2]= VV[34];
(void)simple_symlispcall_no_event(VV[64],base+0,3);
VV[36]->s.s_stype=(short)stp_special;
if(VV[36]->s.s_dbind == OBJNULL){
VV[36]->s.s_dbind = Cnil;}
VV[37]->s.s_stype=(short)stp_special;
if(VV[37]->s.s_dbind == OBJNULL){
VV[37]->s.s_dbind = Cnil;}
VV[38]->s.s_stype=(short)stp_special;
if(VV[38]->s.s_dbind == OBJNULL){
VV[38]->s.s_dbind = Cnil;}
VV[39]->s.s_stype=(short)stp_special;
if(VV[39]->s.s_dbind == OBJNULL){
VV[39]->s.s_dbind = Cnil;}
MF(VV[65],L18,start,size,data);
vs_top=vs_base=base;
}
/* macro definition for WITH-OPEN-STREAM */
static L2()
{ register object *base=vs_base;
register object *sup=base+VM3;
vs_reserve(VM3);
check_arg(2);
vs_top=sup;
{object V1=base[0]->c.c_cdr;
if(endp(V1))invalid_macro_call();
{object V2= (V1->c.c_car);
if(endp(V2))invalid_macro_call();
base[2]= (V2->c.c_car);
V2=V2->c.c_cdr;
if(endp(V2))invalid_macro_call();
base[3]= (V2->c.c_car);
V2=V2->c.c_cdr;
if(!endp(V2))invalid_macro_call();}
V1=V1->c.c_cdr;
base[4]= V1;}
base[6]= base[4];
symlispcall_no_event(VV[66],base+6,1);
Llist();
vs_top=sup;
base[5]= vs_base[0];
base[6]= car(base[5]);
base[7]= cadr(base[5]);
base[8]= list(2,base[2],base[3]);
base[9]= make_cons(base[8],Cnil);
base[10]= make_cons(VV[3],base[7]);
base[11]= list(2,VV[4],base[2]);
base[12]= list(3,VV[2],base[10],base[11]);
base[13]= make_cons(base[12],Cnil);
base[14]= append(base[6],base[13]);
base[15]= listA(3,VV[1],base[9],base[14]);
vs_top=(vs_base=base+15)+1;
return;
}
/* macro definition for WITH-INPUT-FROM-STRING */
static L3()
{ register object *base=vs_base;
register object *sup=base+VM4;
vs_reserve(VM4);
check_arg(2);
vs_top=sup;
{object V3=base[0]->c.c_cdr;
if(endp(V3))invalid_macro_call();
{object V4= (V3->c.c_car);
if(endp(V4))invalid_macro_call();
base[2]= (V4->c.c_car);
V4=V4->c.c_cdr;
if(endp(V4))invalid_macro_call();
base[3]= (V4->c.c_car);
V4=V4->c.c_cdr;
{object V5=getf(V4,VV[67],OBJNULL);
if(V5==OBJNULL){
base[4]= Cnil;
} else {
base[4]= V5;}}
{object V6=getf(V4,VV[68],OBJNULL);
if(V6==OBJNULL){
base[5]= Cnil;
} else {
base[5]= V6;}}
{object V7=getf(V4,VV[69],OBJNULL);
if(V7==OBJNULL){
base[6]= Cnil;
} else {
base[6]= V7;}}
check_other_key(V4,3,VV[67],VV[68],VV[69]);}
V3=V3->c.c_cdr;
base[7]= V3;}
if((base[4])==Cnil){
goto T32;}
base[9]= base[7];
symlispcall_no_event(VV[66],base+9,1);
Llist();
vs_top=sup;
base[8]= vs_base[0];
base[9]= car(base[8]);
base[10]= cadr(base[8]);
base[11]= list(4,VV[5],base[3],base[5],base[6]);
base[12]= list(2,base[2],base[11]);
base[13]= make_cons(base[12],Cnil);
base[14]= make_cons(VV[3],base[10]);
base[15]= list(2,VV[7],base[2]);
base[16]= list(3,VV[6],base[4],base[15]);
base[17]= list(3,VV[2],base[14],base[16]);
base[18]= make_cons(base[17],Cnil);
base[19]= append(base[9],base[18]);
base[20]= listA(3,VV[1],base[13],base[19]);
vs_top=(vs_base=base+20)+1;
return;
T32:;
base[8]= list(4,VV[5],base[3],base[5],base[6]);
base[9]= list(2,base[2],base[8]);
base[10]= make_cons(base[9],Cnil);
base[11]= listA(3,VV[1],base[10],base[7]);
vs_top=(vs_base=base+11)+1;
return;
}
/* macro definition for WITH-OUTPUT-TO-STRING */
static L4()
{ register object *base=vs_base;
register object *sup=base+VM5;
vs_reserve(VM5);
check_arg(2);
vs_top=sup;
{object V8=base[0]->c.c_cdr;
if(endp(V8))invalid_macro_call();
{object V9= (V8->c.c_car);
if(endp(V9))invalid_macro_call();
base[2]= (V9->c.c_car);
V9=V9->c.c_cdr;
if(endp(V9)){
base[3]= Cnil;
} else {
base[3]= (V9->c.c_car);
V9=V9->c.c_cdr;}
if(!endp(V9))invalid_macro_call();}
V8=V8->c.c_cdr;
base[4]= V8;}
if((base[3])==Cnil){
goto T41;}
base[5]= list(2,VV[8],base[3]);
base[6]= list(2,base[2],base[5]);
base[7]= make_cons(base[6],Cnil);
base[8]= listA(3,VV[1],base[7],base[4]);
vs_top=(vs_base=base+8)+1;
return;
T41:;
base[5]= list(2,base[2],VV[9]);
base[6]= make_cons(base[5],Cnil);
base[7]= list(2,VV[10],base[2]);
base[8]= make_cons(base[7],Cnil);
base[9]= append(base[4],base[8]);
base[10]= listA(3,VV[1],base[6],base[9]);
vs_top=(vs_base=base+10)+1;
return;
}
/* function definition for READ-FROM-STRING */
static L5()
{ register object *base=vs_base;
register object *sup=base+VM6;
vs_reserve(VM6);
if(vs_top-vs_base<1) too_few_arguments();
parse_key(vs_base+3,FALSE,FALSE,3,VV[68],VV[69],VV[70]);
vs_base += 1;
if(vs_base>=vs_top){vs_top=sup;goto T43;}
vs_base++;
if(vs_base>=vs_top){vs_top=sup;goto T44;}
vs_top=sup;goto T45;
T43:;
base[1]= Ct;
T44:;
base[2]= Cnil;
T45:;
if(base[6]==Cnil){
base[3]= VV[11];
}else{}
if(base[7]==Cnil){
base[4]= make_fixnum(length(base[0]));
}else{}
base[10]= base[0];
base[11]= base[3];
base[12]= base[4];
base[9]= simple_symlispcall_no_event(VV[5],base+10,3);
if((base[5])==Cnil){
goto T55;}
base[11]= base[9];
base[12]= base[1];
base[13]= base[2];
base[10]= simple_symlispcall_no_event(VV[71],base+11,3);
base[12]= base[9];
base[11]= simple_symlispcall_no_event(VV[7],base+12,1);
vs_base=base+10;vs_top=base+12;
return;
T55:;
base[11]= base[9];
base[12]= base[1];
base[13]= base[2];
vs_top=(vs_base=base+11)+3;
Lread();
vs_top=sup;
base[10]= vs_base[0];
base[12]= base[9];
base[11]= simple_symlispcall_no_event(VV[7],base+12,1);
vs_base=base+10;vs_top=base+12;
return;
}
/* function definition for WRITE-TO-STRING */
static L6()
{ register object *base=vs_base;
register object *sup=base+VM7;
vs_reserve(VM7);
if(vs_top-vs_base<1) too_few_arguments();
parse_key(vs_base+1,TRUE,FALSE,10,VV[72],VV[73],VV[74],VV[75],VV[76],VV[77],VV[78],VV[79],VV[80],VV[81]);
vs_top=sup;
base[22]= simple_symlispcall_no_event(VV[82],base+23,0);
base[23]= base[0];
base[24]= VV[12];
base[25]= base[22];
{object V10;
V10= base[1];
vs_top=base+26;
while(!endp(V10))
{vs_push(car(V10));V10=cdr(V10);}
vs_base=base+23;}
Lwrite();
vs_top=sup;
base[23]= base[22];
symlispcall_no_event(VV[10],base+23,1);
return;
}
/* function definition for PRIN1-TO-STRING */
static L7()
{ register object *base=vs_base;
register object *sup=base+VM8;
vs_reserve(VM8);
check_arg(1);
vs_top=sup;
TTL:;
base[1]= simple_symlispcall_no_event(VV[82],base+2,0);
(void)(prin1(base[0],base[1]));
base[2]= base[1];
symlispcall_no_event(VV[10],base+2,1);
return;
}
/* function definition for PRINC-TO-STRING */
static L8()
{ register object *base=vs_base;
register object *sup=base+VM9;
vs_reserve(VM9);
check_arg(1);
vs_top=sup;
TTL:;
base[1]= simple_symlispcall_no_event(VV[82],base+2,0);
(void)(princ(base[0],base[1]));
base[2]= base[1];
symlispcall_no_event(VV[10],base+2,1);
return;
}
/* macro definition for WITH-OPEN-FILE */
static L9()
{ register object *base=vs_base;
register object *sup=base+VM10;
vs_reserve(VM10);
check_arg(2);
vs_top=sup;
{object V11=base[0]->c.c_cdr;
if(endp(V11))invalid_macro_call();
{object V12= (V11->c.c_car);
if(endp(V12))invalid_macro_call();
base[2]= (V12->c.c_car);
V12=V12->c.c_cdr;
base[3]= V12;}
V11=V11->c.c_cdr;
base[4]= V11;}
base[6]= base[4];
symlispcall_no_event(VV[66],base+6,1);
Llist();
vs_top=sup;
base[5]= vs_base[0];
base[6]= car(base[5]);
base[7]= cadr(base[5]);
base[8]= make_cons(VV[13],base[3]);
base[9]= list(2,base[2],base[8]);
base[10]= make_cons(base[9],Cnil);
base[11]= make_cons(VV[3],base[7]);
base[12]= list(2,VV[4],base[2]);
base[13]= list(3,VV[2],base[11],base[12]);
base[14]= make_cons(base[13],Cnil);
base[15]= append(base[6],base[14]);
base[16]= listA(3,VV[1],base[10],base[15]);
vs_top=(vs_base=base+16)+1;
return;
}
/* function definition for Y-OR-N-P */
static L10()
{ register object *base=vs_base;
register object *sup=base+VM11;
vs_reserve(VM11);
if(vs_base>=vs_top){vs_top=sup;goto T87;}
vs_base++;
vs_top[0]=Cnil;
{object *p=vs_top;
for(;p>vs_base;p--)p[-1]=MMcons(p[-1],p[0]);}
vs_top=sup;
goto T88;
T87:;
base[0]= Cnil;
base[1]= Cnil;
T88:;
base[2]= Cnil;
T91:;
if((base[0])==Cnil){
goto T94;}
base[3]= symbol_value(VV[14]);
base[4]= VV[15];
base[5]= base[0];
base[6]= base[1];
vs_top=(vs_base=base+3)+4;
Lformat();
vs_top=sup;
T94:;
base[3]= symbol_value(VV[14]);
vs_top=(vs_base=base+3)+1;
Lread();
vs_top=sup;
base[2]= vs_base[0];
base[4]= base[2];
vs_top=(vs_base=base+4)+1;
Lsymbol_name();
vs_top=sup;
base[3]= vs_base[0];
base[4]= VV[16];
vs_top=(vs_base=base+3)+2;
Lstring_equal();
vs_top=sup;
if((vs_base[0])==Cnil){
goto T106;}
base[3]= Ct;
vs_top=(vs_base=base+3)+1;
return;
T106:;
base[4]= base[2];
vs_top=(vs_base=base+4)+1;
Lsymbol_name();
vs_top=sup;
base[3]= vs_base[0];
base[4]= VV[17];
vs_top=(vs_base=base+3)+2;
Lstring_equal();
vs_top=sup;
if((vs_base[0])==Cnil){
goto T104;}
base[3]= Cnil;
vs_top=(vs_base=base+3)+1;
return;
T104:;
goto T91;
}
/* function definition for YES-OR-NO-P */
static L11()
{ register object *base=vs_base;
register object *sup=base+VM12;
vs_reserve(VM12);
if(vs_base>=vs_top){vs_top=sup;goto T118;}
vs_base++;
vs_top[0]=Cnil;
{object *p=vs_top;
for(;p>vs_base;p--)p[-1]=MMcons(p[-1],p[0]);}
vs_top=sup;
goto T119;
T118:;
base[0]= Cnil;
base[1]= Cnil;
T119:;
base[2]= Cnil;
T122:;
if((base[0])==Cnil){
goto T125;}
base[3]= symbol_value(VV[14]);
base[4]= VV[18];
base[5]= base[0];
base[6]= base[1];
vs_top=(vs_base=base+3)+4;
Lformat();
vs_top=sup;
T125:;
base[3]= symbol_value(VV[14]);
vs_top=(vs_base=base+3)+1;
Lread();
vs_top=sup;
base[2]= vs_base[0];
base[4]= base[2];
vs_top=(vs_base=base+4)+1;
Lsymbol_name();
vs_top=sup;
base[3]= vs_base[0];
base[4]= VV[19];
vs_top=(vs_base=base+3)+2;
Lstring_equal();
vs_top=sup;
if((vs_base[0])==Cnil){
goto T137;}
base[3]= Ct;
vs_top=(vs_base=base+3)+1;
return;
T137:;
base[4]= base[2];
vs_top=(vs_base=base+4)+1;
Lsymbol_name();
vs_top=sup;
base[3]= vs_base[0];
base[4]= VV[20];
vs_top=(vs_base=base+3)+2;
Lstring_equal();
vs_top=sup;
if((vs_base[0])==Cnil){
goto T135;}
base[3]= Cnil;
vs_top=(vs_base=base+3)+1;
return;
T135:;
goto T122;
}
/* function definition for SHARP-A-READER */
static L12()
{ register object *base=vs_base;
register object *sup=base+VM13;
vs_reserve(VM13);
check_arg(3);
vs_top=sup;
TTL:;
base[4]= base[0];
base[5]= Cnil;
base[6]= Cnil;
base[7]= Ct;
vs_top=(vs_base=base+4)+4;
Lread();
vs_top=sup;
base[3]= vs_base[0];
if((symbol_value(VV[21]))==Cnil){
goto T155;}
base[4]= Cnil;
vs_top=(vs_base=base+4)+1;
return;
T155:;
base[4]= VV[11];
base[5]= Cnil;
base[6]= base[3];
T158:;
if(!(number_compare(base[4],base[2])>=0)){
goto T159;}
base[7]=symbol_function(VV[83]);
base[8]= nreverse(base[5]);
base[9]= VV[22];
base[10]= base[3];
lispcall_no_event(base+7,3);
return;
T159:;
base[4]= one_plus(base[4]);
base[7]= make_fixnum(length(base[6]));
base[5]= make_cons(base[7],base[5]);
base[6]= elt(base[6],0);
goto T158;
}
/* function definition for SHARP-S-READER */
static L15()
{ register object *base=vs_base;
register object *sup=base+VM14;
vs_reserve(VM14);
check_arg(3);
vs_top=sup;
TTL:;
if((base[2])==Cnil){
goto T171;}
if((symbol_value(VV[21]))!=Cnil){
goto T171;}
base[3]= VV[27];
base[4]= base[2];
vs_top=(vs_base=base+3)+2;
Lerror();
vs_top=sup;
T171:;
base[4]= base[0];
vs_top=(vs_base=base+4)+1;
Lread();
vs_top=sup;
base[3]= vs_base[0];
if((get(car(base[3]),VV[28],Cnil))!=Cnil){
goto T180;}
base[4]= VV[29];
base[5]= car(base[3]);
vs_top=(vs_base=base+4)+2;
Lerror();
vs_top=sup;
T180:;
base[4]= cdr(base[3]);
T187:;
if(!(endp(base[4]))){
goto T188;}
base[5]= get(car(base[3]),VV[30],Cnil);
T193:;
if(!(endp(base[5]))){
goto T194;}
base[6]= VV[31];
base[7]= car(base[3]);
vs_top=(vs_base=base+6)+2;
Lerror();
return;
T194:;
if(!(type_of(car(base[5]))==t_symbol)){
goto T200;}
base[6]= car(base[5]);
{object V13;
V13= cdr(base[3]);
vs_top=base+7;
while(!endp(V13))
{vs_push(car(V13));V13=cdr(V13);}
vs_base=base+7;}
super_funcall_no_event(base[6]);
return;
T200:;
base[5]= cdr(base[5]);
goto T193;
T188:;
base[6]= coerce_to_string(car(base[4]));
base[7]= VV[32];
vs_top=(vs_base=base+6)+2;
Lintern();
vs_top=sup;
base[5]= vs_base[0];
if(type_of(base[4])!=t_cons)FEwrong_type_argument(Scons,base[4]);
(base[4])->c.c_car = base[5];
base[4]= cddr(base[4]);
goto T187;
}
/* function definition for DRIBBLE */
static L18()
{ register object *base=vs_base;
register object *sup=base+VM15;
vs_reserve(VM15);
if(vs_top-vs_base>2) too_many_arguments();
if(vs_base>=vs_top){vs_top=sup;goto T216;}
base[2]= Ct;
vs_base++;
if(vs_base>=vs_top){vs_top=sup;goto T217;}
vs_top=sup;
goto T218;
T216:;
base[0]= VV[40];
base[2]= Cnil;
T217:;
base[1]= VV[41];
T218:;
if((base[2])!=Cnil){
goto T222;}
if((symbol_value(VV[36]))!=Cnil){
goto T224;}
base[3]= VV[42];
vs_top=(vs_base=base+3)+1;
Lerror();
vs_top=sup;
T224:;
if(!(symbol_value(VV[37])==symbol_value(VV[43]))){
goto T230;}
setq(VV[43],symbol_value(VV[39]));
goto T228;
T230:;
base[3]= VV[44];
(void)simple_symlispcall_no_event(VV[84],base+3,1);
T228:;
base[3]= symbol_value(VV[36]);
vs_top=(vs_base=base+3)+1;
Lclose();
vs_top=sup;
setq(VV[36],Cnil);
base[3]= Ct;
base[4]= VV[45];
base[5]= symbol_value(VV[38]);
vs_top=(vs_base=base+3)+3;
Lformat();
return;
T222:;
if((symbol_value(VV[36]))==Cnil){
goto T242;}
base[3]= VV[46];
base[4]= symbol_value(VV[38]);
vs_top=(vs_base=base+3)+2;
Lerror();
return;
T242:;
base[4]= base[0];
vs_top=(vs_base=base+4)+1;
Lnamestring();
vs_top=sup;
base[3]= vs_base[0];
base[5]= base[0];
base[6]= VV[47];
base[7]= VV[48];
base[8]= VV[49];
base[9]= base[1];
base[10]= VV[50];
base[11]= VV[51];
vs_top=(vs_base=base+5)+7;
Lopen();
vs_top=sup;
base[4]= vs_base[0];
setq(VV[38],base[3]);
setq(VV[36],base[4]);
setq(VV[39],symbol_value(VV[43]));
base[6]= symbol_value(VV[43]);
base[7]= base[4];
vs_top=(vs_base=base+6)+2;
Lmake_echo_stream();
vs_top=sup;
base[5]= vs_base[0];
base[7]= symbol_value(VV[43]);
base[8]= base[4];
vs_top=(vs_base=base+7)+2;
Lmake_broadcast_stream();
vs_top=sup;
base[6]= vs_base[0];
vs_top=(vs_base=base+5)+2;
Lmake_two_way_stream();
vs_top=sup;
setq(VV[37],vs_base[0]);
setq(VV[43],symbol_value(VV[37]));
symlispcall_no_event(VV[85],base+6,0);
Llist();
vs_top=sup;
base[5]= vs_base[0];
base[6]= car(base[5]);
base[7]= cadr(base[5]);
base[8]= caddr(base[5]);
base[9]= cadddr(base[5]);
base[10]= car(cddddr(base[5]));
base[11]= cadr(cddddr(base[5]));
base[12]= Ct;
base[13]= VV[52];
base[14]= base[3];
base[15]= base[11];
base[16]= base[10];
base[17]= base[9];
base[18]= base[8];
base[19]= base[7];
base[20]= base[6];
vs_top=(vs_base=base+12)+9;
Lformat();
return;
}